perm filename READIN.F4[MUS,LCS] blob sn#007394 filedate 1974-01-08 generic text, type T, neo UTF8
00100		SUBROUTINE READIN(SOURCE,QUANT,XOUT,LSIZE,FOOGY)
00200	C   UNIT GEN. 'READ' = - READ(SOURCE,QUANT,ARRAY,INPUT NCHNS);
00300	C	OUTPUTS ARE RDA, RDB, RDC AND RDD. DON'T USE U1, ETC.
00400	C   IF SOURCE<100 IT =4TH LETTER.  E.G. 4 WILL READ FROM MUSDA (4=D)
00500	C   IF SOURCE>100, LAST 2 DIGITS ARE LAST LETTER, 1ST 2 ARE 4TH LETTER.
00600	C     E.G. 312 WILL READ FROM MUSCL (3=C, 12=L).   1213 = MUSLM
00700	C   LOAD AFTER MUSY,MUSIO,NSCTPY
00800	C   MUSIO SHOULD INCLUDE MTA1 CALLS.
00900	
01000		COMMON ISAVE
01100		DIMENSION IOUT(2128),XOUT(512),IX(128),IH(5)
01200		DATA IH(1)/'  REA'/,IH(2)/'DING '/,IH(4)/' / '/
01300		EQUIVALENCE(IOUT(2001),IX),(K,IH(5))
01400		IF(FOOGY)GO TO 1
01450	C  FOOGY>-1 MEANS FIRST TIME THROUGH.
01500		KSIZE=LSIZE/2
01600	C  KSIZE IS NUM OF 36-BIT WORDS TO PROCESS.
01700		NAME='MUSAA'
01800		JMP=-1
01900		ISAVE=-1
02000		MTA=0
02100		JA=1
02200		JNM='AAAAA'
02300		K=QUANT-1.
02400		JC=0
02500		IF(SOURCE.LT.100.)GO TO 4
02600		NAME=SOURCE/100.
02700	C  GETS # FOR 1ST LETTER.
02800		JC=SOURCE-NAME*100
02900		IF(JC.NE.0)JC=JC-1
03000	C  GETS 2ND LETTER.
03100		JNM=NAME-1
03200		GO TO 10
03300	4	IF(SOURCE.GT.0)GO TO 2
03400		MTA=-1
03500		JNM=NAME
03600		CALL MTA1
03700		GO TO 3
03800	2	JNM=SOURCE-1.
03900	10	JNM='MUSAA'+256*JNM
04000	3	KNM=JNM
04100		NAME=JNM+JC*2
04150		JC=K*2
04200		NM2=NAME+JC
04210		JADD=JNM+52-NAME
04220		IF(JC.GT.JADD)NM2=JNM+256+JC-JADD
04240	C  IF NAME GOES FROM AZ TO BA
04260	712	IF(NM2.GT.JNM+306)NM2=JNM+512+JC-52-JADD
04290	C  IF NAME GOES FROM AZ TO CA
04300	CC	IF(K.GT.26)NM2=NAME+256+(K-26)*2
04400	C  AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
04500	710	IF(MTA)GO TO 811
04600	711	CALL GETFI2(NAME)
04700		IH(3)=NAME
04800		CALL MESS(IH)
04900		GO TO 810
05100	811	CALL INMTA1(IX(1),128)
05125		IH(3)=IX(3)
05137		CALL MESS(IH)
05150		MCNT=0
05175	C  MCNT COUNTS RECORDS READ ON MTA1
05187		ISAVE=-1
05200		IF(IX(1))GO TO 1201
05250	C  IF NEG., IT'S THE END OF THE TAPE.
05300		GO TO 2022
05400	810	CALL FASTI2(IX(1),128)
05500		KCNT=2
05600	2022	JSC=IX(1)
05700		JADD=JSC/128
05800		IF(JSC-JADD*128.NE.0)JADD=JADD+1
05900	C  JADD IS # OF 128 WD. RECORDS READ.
06000	1022	IF(JA.GT.KSIZE)GO TO 17
06100	610	IF(MTA)GO TO 611
06200		CALL FASTI2(IOUT(JA),JSC)
06300		KCNT=KCNT+JADD
06400		GO TO 612
06500	C   LAST WORD IS THROWN AWAY.
06600	611	IF(ISAVE.NE.-2)GO TO 614
06610		CALL MTA1
06620		CALL INMTA1(IX(1),128)
06630		DO 6141 K=1,MCNT
06640	6141	CALL INMTA1(IOUT(JA),JSC)
06650		ISAVE=-1
06660		GO TO 612
06670	C  REREADS TAPE UP TO THE RIGHT SPOT.
06800	614	CALL INMTA1(IOUT(JA),JSC)
06810		MCNT=MCNT+1
06900	612	JA=JA+JSC-1
07000		JC=IOUT(JA)
07100		IF(JC)5,1022,6
07200	5	JA=JA-IOUT(JA-1)
07300	6	NAME=NAME+2
07400		IF(NAME.LE.JNM+50)GO TO 27
07500		JNM=JNM+256
07600	C   RAISES 'AAAZA' TO 'AABAA'
07700	1017	NAME=JNM
07800	27	IF(NAME.LE.NM2)GO TO 710
07900	1201	NM2=NAME-1
08000	17	CALL ZBIT(IOUT,XOUT)
08100	9	RETURN
08200	1	IF(ISAVE)GO TO 171
08300		ISAVE=-1
08400		IF(NAME.GT.NM2)GO TO 171
08500		IF(MTA.EQ.0)GO TO 271
08510		ISAVE=-2
08520		GO TO 171
08600	C    USE 'TAPNEW' TO 'RESET' TAPE.
08700	271	CALL GETFI2(NAME)
08800		CALL USETI(KCNT)
08810	C  REREADS KCNT RECORDS OF 128 WDS.
09000	171	JC=JA-1
09100		IF(JMP)7,8,9
09200	7	JC=JC-KSIZE
09300		DO 12 K=1,JC
09400	12	IOUT(K)=IOUT(K+KSIZE)
09500		JA=JC+1
09600		IF(JC.GT.KSIZE)GO TO 17
09700		IF(NAME.LE.NM2)GO TO 610
09800	43	DO 13 K=JC+1,KSIZE
09900	13	IOUT(K)=0
10000		JMP=0
10100		GO TO 17
10200	8 	DO 14 K=1,KSIZE
10300	14	IOUT(K)=0
10400		JMP=1
10500		GO TO 17
10600		END
10700	CC 
10800	CC 
10900	CC NCHNS←2;SRATE←25000;
11000	CC COMPILE;INSTRUMENT XX;
11100	CC READ(P3,P4,F1,P5);OUTA←OUTA+RDB;<CHAN2 DATA IS PUT IN BOTH CHANS.
11200	CC OUTB←OUTB+RDB*P6;END;FINISH;
11300	CC BIGBIT←2;
11400	CC PLAY;XX 0 3 4 3 2 2;FINISH;< MULTS SAMPLES BY 2 IN CH2, READS MUSDA, STEREO
11500	CC  DO FILE FOLLOWS:
11600	CC	LOA %DMUSY,NSCTPY,READIN,MUSIO↔C 14↔S↔DSK:NOTEY↔